#lang rosetta-racket


(provide tholos)


(define (abacus width height)
  (box width width height))

(define (echinus top-radius bottom-radius height)
  (cone-frustum bottom-radius height top-radius))

(define (shaft top-radius bottom-radius height)
  (cone-frustum bottom-radius height top-radius))

(define (doric-column (top-width 2)
                      (middle-radius 0.8)
                      (bottom-radius 1)
                      (abacus-height 0.5)
                      (echinus-height 0.5)
                      (shaft-height 10))
  (let ((shaft (shaft middle-radius bottom-radius shaft-height))
        (echinus (echinus (/ top-width 2) middle-radius echinus-height))
        (abacus (abacus top-width abacus-height)))
    (on-top abacus echinus shaft)))

(define (base r (h 1) (n 3))
  (on-top
   (map
    (λ (n)
      (cylinder (+ r (* n h)) h))
    (: < 1 .. < n > >))))

(define (circle-placement radius n)
  (map
   (λ (segment) (segment-cs segment (union (doric-column))))
   (cut (par (circle radius)) n)))

(define (tholos base-r n-columns (edge-distance 0.1))
  (on-top
   (union (circle-placement (- base-r edge-distance) n-columns))
   (union (base base-r))))